home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyDialogs.p < prev    next >
Encoding:
Text File  |  1994-09-08  |  15.1 KB  |  600 lines  |  [TEXT/PJMM]
  1. unit MyDialogs;
  2.  
  3. interface
  4.  
  5.     const
  6.         i_ok = 1;
  7.         i_cancel = 2;
  8.         i_discard = 3;
  9.  
  10.     type
  11.         SavedWindowInfo = record
  12.                 oldport: GrafPtr;
  13.                 thisport: GrafPtr;
  14.                 font: integer;
  15.                 size: integer;
  16.                 face: Style;
  17.             end;
  18.  
  19.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style; var saved: SavedWindowInfo);
  20.     procedure ExitWindow (saved: SavedWindowInfo);
  21.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  22.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  23.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  24.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  25.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  26.     procedure FlashDItem (dlg: dialogPtr; item: integer);
  27.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  28.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  29.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  30.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  31.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  32.     function GetDItemHandle (dp: dialogPtr; item: integer): handle;
  33.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  34.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  35.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  36.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  37.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  38.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  39.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  40.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  41.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  42.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  43.     function GetDCtlMax (dp: dialogPtr; item: integer): integer;
  44.     procedure SetDCtlMax (dp: dialogPtr; item: integer; value: integer);
  45.     function GetDCtlMin (dp: dialogPtr; item: integer): integer;
  46.     procedure SetDCtlMin (dp: dialogPtr; item: integer; value: integer);
  47.     function GetDCtlHilite (dlg: DialogPtr; item: integer): integer;
  48.     procedure SetDCtlHilite (dlg: DialogPtr; item: integer; hilite: integer);
  49.     procedure DrawDItem (dp: dialogPtr; item: integer);
  50.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  51.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  52.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  53.     procedure GetDAFont (var font: integer);
  54.     procedure SetWindowTitle (window: windowPtr; title: str255);
  55.     function SelectedTextItem (dlg: DialogPtr): integer;
  56.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  57.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  58. { s= "font:size:style:just:text" }
  59.     procedure ShiftTab (dlg: DialogPtr);
  60.     function CountDItems (dlg: DialogPtr): integer;
  61.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  62.     function CancelDiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  63.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  64.  
  65. implementation
  66.  
  67.     uses
  68.         MyStrings, MyUtils;
  69.  
  70.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  71.         var
  72.             it: integer;
  73.             ih: handle;
  74.             box: rect;
  75.             oldtext: str255;
  76.     begin
  77.         GetDItem(dlg, item, it, ih, box);
  78.         GetIText(ih, oldtext);
  79.         if oldtext <> text then
  80.             SetIText(ih, text);
  81.     end;
  82.  
  83.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  84.         var
  85.             it: integer;
  86.             ih: handle;
  87.             box: rect;
  88.     begin
  89.         GetDItem(dlg, item, it, ih, box);
  90.         GetIText(ih, text);
  91.     end;
  92.  
  93.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  94.         var
  95.             text: str255;
  96.     begin
  97.         GetItemText(dlg, item, text);
  98.         GetItemTextF := text;
  99.     end;
  100.  
  101.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  102.         var
  103.             r: rect;
  104.             disabled: boolean;
  105.     begin
  106.         SetPort(dp);
  107.         GetDItemRect(dp, 1, r);
  108.         disabled := not GetDCtlEnable(dp, 1);
  109.         PenSize(3, 3);
  110.         InsetRect(r, -4, -4);
  111.         if disabled then begin
  112.             PenPat(gray);
  113.         end;
  114.         FrameRoundRect(r, 16, 16);
  115.         if disabled then begin
  116.             PenPat(black);
  117.         end;
  118.         PenNormal;
  119.     end;
  120.  
  121.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  122.         var
  123.             kind: integer;
  124.             h: handle;
  125.             r: rect;
  126.     begin
  127.         if def_item <> 1 then
  128.             DebugStr('SetUpDefaultOutline:Cant handle anything except 1 yet');
  129.         GetDItem(dp, user_item, kind, h, r);
  130.         InsetRect(r, -10, -10);
  131.         SetDItem(dp, user_item, userItem, handle(@OutlineDefault1), r);
  132.     end;
  133.  
  134.     procedure FlashDItem (dlg: dialogPtr; item: integer);
  135.         var
  136.             f: longInt;
  137.     begin
  138.         SetDCtlHilite(dlg, item, inButton);
  139.         Delay(2, f);
  140.         SetDCtlHilite(dlg, item, 0);
  141.     end;
  142.  
  143.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  144.         var
  145.             kind: integer;
  146.             h: handle;
  147.             r: rect;
  148.     begin
  149.         GetDItem(dp, item, kind, h, r);
  150.         SetDItem(dp, item, kind, h, rr);
  151.     end;
  152.  
  153.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  154.         var
  155.             kind: integer;
  156.             h: handle;
  157.     begin
  158.         GetDItem(dp, item, kind, h, rr);
  159.     end;
  160.  
  161.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  162.         var
  163.             kk: integer;
  164.             h: handle;
  165.             r: rect;
  166.     begin
  167.         GetDItem(dp, item, kk, h, r);
  168.         SetDItem(dp, item, k, h, r);
  169.     end;
  170.  
  171.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  172.         var
  173.             r: rect;
  174.             h: handle;
  175.     begin
  176.         GetDItem(dp, item, k, h, r);
  177.     end;
  178.  
  179.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  180.     begin
  181.         GetDControlHandle := ControlHandle(GetDItemHandle(dp, item));
  182.     end;
  183.  
  184.     function GetDItemhandle (dp: dialogPtr; item: integer): handle;
  185.         var
  186.             kind: integer;
  187.             h: handle;
  188.             r: rect;
  189.     begin
  190.         GetDItem(dp, item, kind, h, r);
  191.         GetDItemhandle := h;
  192.     end;
  193.  
  194.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  195.         var
  196.             kind: integer;
  197.             hh: handle;
  198.             r: rect;
  199.     begin
  200.         GetDItem(dp, item, kind, hh, r);
  201.         SetDItem(dp, item, kind, h, r);
  202.     end;
  203.  
  204.     function GetDCtlHilite (dlg: DialogPtr; item: integer): integer;
  205.     begin
  206.         GetDCtlHilite := controlHandle(GetDItemHandle(dlg, item))^^.contrlHilite;
  207.     end;
  208.  
  209.     procedure SetDCtlHilite (dlg: DialogPtr; item: integer; hilite: integer);
  210.         var
  211.             ch: ControlHandle;
  212.     begin
  213.         ch := controlHandle(GetDItemHandle(dlg, item));
  214.         if ch^^.contrlHilite <> hilite then begin
  215.             HiliteControl(ch, hilite);
  216.         end;
  217.     end;
  218.  
  219.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  220.     begin
  221.         GetDCtlEnable := GetDCtlHilite(dlg, item) <> 255;
  222.     end;
  223.  
  224.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  225.     begin
  226.         SetDCtlHilite(dp, item, 255 * ord(not on))
  227.     end;
  228.  
  229.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  230.         var
  231.             s: str255;
  232.     begin
  233.         GetCTitle(GetDControlHandle(dp, item), s);
  234.         GetDCtlTitle := s;
  235.     end;
  236.  
  237.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  238.         var
  239.             ch: ControlHandle;
  240.             old: str255;
  241.     begin
  242.         ch := GetDControlHandle(dp, item);
  243.         GetCTitle(ch, old);
  244.         if old <> s then begin
  245.             SetCTitle(ch, s);
  246.         end;
  247.     end;
  248.  
  249.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  250.     begin
  251.         GetDCtlBoolean := GetCtlValue(GetDControlHandle(dp, item)) <> 0;
  252.     end;
  253.  
  254.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  255.     begin
  256.         SetCtlValue(GetDControlHandle(dp, item), ord(value));
  257.     end;
  258.  
  259.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  260.     begin
  261.         SetDCtlBoolean(dp, item, not GetDCtlBoolean(dp, item));
  262.     end;
  263.  
  264.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  265.     begin
  266.         GetDCtlValue := GetCtlValue(GetDControlHandle(dp, item));
  267.     end;
  268.  
  269.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  270.     begin
  271.         SetCtlValue(GetDControlHandle(dp, item), value);
  272.     end;
  273.  
  274.     function GetDCtlMax (dp: dialogPtr; item: integer): integer;
  275.     begin
  276.         GetDCtlMax := GetCtlMax(GetDControlHandle(dp, item));
  277.     end;
  278.  
  279.     procedure SetDCtlMax (dp: dialogPtr; item: integer; value: integer);
  280.     begin
  281.         SetCtlMax(GetDControlHandle(dp, item), value);
  282.     end;
  283.  
  284.     function GetDCtlMin (dp: dialogPtr; item: integer): integer;
  285.     begin
  286.         GetDCtlMin := GetCtlMin(GetDControlHandle(dp, item));
  287.     end;
  288.  
  289.     procedure SetDCtlMin (dp: dialogPtr; item: integer; value: integer);
  290.     begin
  291.         SetCtlMin(GetDControlHandle(dp, item), value);
  292.     end;
  293.  
  294.     procedure DrawDItem (dp: dialogPtr; item: integer);
  295.     begin
  296.         Draw1Control(GetDControlHandle(dp, item));
  297.     end;
  298.  
  299.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  300.         type
  301.             MenuHandlePtr = ^MenuHandle;
  302.             MenuHandleHandle = ^MenuHandlePtr;
  303.     begin
  304.         GetPopupMHandle := MenuHandleHandle(ControlHandle(GetDItemHandle(dlg, item))^^.contrlData)^^;
  305.     end;
  306.  
  307.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  308.         var
  309.             mh: MenuHandle;
  310.             i, index, start: integer;
  311.             s: str255;
  312.             added: boolean;
  313.     begin
  314.         mh := GetPopupMHandle(dlg, item);
  315.         if text = '' then begin
  316.             GetItem(mh, 1, text);
  317.         end;
  318.         GetItem(mh, 2, s);
  319.         if s = '-' then begin
  320.             DelMenuItem(mh, 2);
  321.             DelMenuItem(mh, 1);
  322.         end;
  323.         index := 0;
  324.         for i := 1 to CountMItems(mh) do begin
  325.             GetItem(mh, i, s);
  326.             if (IUEqualString(s, text) = 0) then begin
  327.                 index := i;
  328.                 leave;
  329.             end;
  330.         end;
  331.         if index = 0 then begin
  332.             InsMenuItem(mh, '(-;fred', 0);
  333.             SetItem(mh, 1, text);
  334.             index := 1;
  335.         end;
  336.         SetDCtlValue(dlg, item, index);
  337.     end;
  338.  
  339.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  340.         var
  341.             mh: MenuHandle;
  342.     begin
  343.         mh := GetPopupMHandle(dlg, item);
  344.         GetItem(GetPopupMHandle(dlg, item), GetDCtlValue(dlg, item), text);
  345.     end;
  346.  
  347.     procedure GetDAFont (var font: integer);
  348.         type
  349.             intPtr = ^integer;
  350.         const
  351.             DlgFont = $AFA;
  352.     begin
  353.         font := intPtr(DlgFont)^;
  354.     end;
  355.  
  356.     procedure SetWindowTitle (window: windowPtr; title: str255);
  357.         var
  358.             s: str255;
  359.     begin
  360.         GetWTitle(window, s);
  361.         if s <> title then
  362.             SetWTitle(window, title);
  363.     end;
  364.  
  365.     function SelectedTextItem (dlg: DialogPtr): integer;
  366.     begin
  367.         SelectedTextItem := DialogPeek(dlg)^.editField + 1;
  368.     end;
  369.  
  370.     function CountDItems (dlg: DialogPtr): integer;
  371.     begin
  372. {    count := CountDITL(dlg);}
  373.         CountDItems := integerH(DialogPeek(dlg)^.items)^^ + 1;
  374.     end;
  375.  
  376.     procedure ShiftTab (dlg: DialogPtr);
  377.         var
  378.             gv: longInt;
  379.             orgitem, i, count: integer;
  380.             k: integer;
  381.     begin
  382.         orgitem := SelectedTextItem(dlg);
  383.         count := CountDItems(dlg);
  384.         if (orgitem > 0) & (count > 1) then begin
  385.             i := orgitem;
  386.             repeat
  387.                 i := i - 1;
  388.                 if i = 0 then begin
  389.                     i := count;
  390.                 end;
  391.                 GetDItemKind(dlg, i, k);
  392.             until (i = orgitem) | (k = editText);
  393.         end;
  394.         GetDItemKind(dlg, i, k);
  395.         if k = editText then begin
  396.             SelIText(dlg, i, 0, 255);
  397.         end;
  398.     end;
  399.  
  400.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  401.         var
  402.             clip: RgnHandle;
  403.     begin
  404.         SetPort(window);
  405.         PenNormal;
  406.         clip := NewRgn;
  407.         GetClip(clip);
  408.         ClipRect(bounds);
  409.         DrawGrowIcon(window);
  410.         SetClip(clip);
  411.         DisposeRgn(clip);
  412.     end;
  413.  
  414.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  415.         var
  416.             t: str255;
  417.             box: rect;
  418.             just: integer;
  419.             this: str255;
  420.             font, size, i, index: integer;
  421.             st: Style;
  422.             fi: FontInfo;
  423.             fixsize: boolean;
  424.             oldfont, oldsize: integer;
  425.             oldface: Style;
  426.     begin
  427.         SetPort(dlg);
  428.         oldfont := dlg^.txFont;
  429.         oldsize := dlg^.txSize;
  430.         oldface := dlg^.txFace;
  431.         GetDItemRect(dlg, item, box);
  432.         if Split(':', s, this, s) then begin
  433.             fixsize := false;
  434.             if this = '' then begin
  435.                 font := geneva;
  436.             end
  437.             else begin
  438.                 GetFNum(this, font);
  439.                 if font = 0 then begin
  440.                     fixsize := true;
  441.                     font := geneva;
  442.                 end;
  443.             end;
  444.             if Split(':', s, this, s) then begin
  445.                 if this = '' then begin
  446.                     size := 9;
  447.                 end
  448.                 else begin
  449.                     size := StrToNum(this);
  450.                 end;
  451.                 if Split(':', s, this, s) then begin
  452.                     st := [];
  453.                     for i := 1 to length(this) do begin
  454.                         st := st + [StyleItem(ord(this[i]) - 48)]
  455.                     end;
  456.                     if Split(':', s, this, s) then begin
  457.                         if this = '' then begin
  458.                             just := teJustLeft;
  459.                         end
  460.                         else begin
  461.                             just := StrToNum(this);
  462.                         end;
  463.                         TextFont(font);
  464.                         TextSize(size);
  465.                         TextFace(st);
  466.                         if fixsize then begin
  467.                             GetFontInfo(fi);
  468.                             while (fi.ascent + fi.descent > box.bottom - box.top) do begin
  469.                                 if size > 48 then begin
  470.                                     size := 48;
  471.                                 end
  472.                                 else if size > 36 then begin
  473.                                     size := 36;
  474.                                 end
  475.                                 else if size > 27 then begin
  476.                                     size := 27;
  477.                                 end
  478.                                 else if size > 24 then begin
  479.                                     size := 24;
  480.                                 end
  481.                                 else if size > 18 then begin
  482.                                     size := 18;
  483.                                 end
  484.                                 else if size > 14 then begin
  485.                                     size := 14;
  486.                                 end
  487.                                 else if size > 12 then begin
  488.                                     size := 12;
  489.                                 end
  490.                                 else begin
  491.                                     size := 9;
  492.                                     TextSize(size);
  493.                                     leave;
  494.                                 end;
  495.                                 TextSize(size);
  496.                                 GetFontInfo(fi);
  497.                             end;
  498.                         end;
  499.                         TextBox(@s[1], length(s), box, just);
  500.                     end;
  501.                 end;
  502.             end;
  503.         end;
  504.         TextFont(oldfont);
  505.         TextSize(oldsize);
  506.         TextFace(oldface);
  507.     end;
  508.  
  509.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  510.         var
  511.             ch: integer;
  512.     begin
  513.         CancelModalFilter := false;
  514.         if (er.what = keyDown) or (er.what = autoKey) then begin
  515.             ch := BAND(er.message, $FF);
  516.             if (ch = ord(cr)) or (ch = ord(enter)) then begin
  517.                 item := i_ok;
  518.                 FlashDItem(dlg, item);
  519.                 CancelModalFilter := true;
  520.             end
  521.             else if ((ch = ord('.')) and (BAND(er.modifiers, cmdKey) <> 0)) or (ch = 27) then begin
  522.                 item := i_cancel;
  523.                 FlashDItem(dlg, item);
  524.                 CancelModalFilter := true;
  525.             end;
  526.         end;
  527.     end;
  528.  
  529.     function CancelDiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  530.         var
  531.             ch: integer;
  532.             result: boolean;
  533.     begin
  534.         CancelDiscardModalFilter := false;
  535.         if CancelModalFilter(dlg, er, item) then begin
  536.             CancelDiscardModalFilter := true;
  537.         end
  538.         else if (er.what = keyDown) or (er.what = autoKey) then begin
  539.             ch := BAND(er.message, $FF);
  540.             if (ch = ord('d')) and (BAND(er.modifiers, cmdKey) <> 0) then begin
  541.                 item := i_discard;
  542.                 FlashDItem(dlg, item);
  543.                 CancelDiscardModalFilter := true;
  544.             end;
  545.         end;
  546.     end;
  547.  
  548.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style; var saved: SavedWindowInfo);
  549.     begin
  550.         GetPort(saved.oldport);
  551.         SetPort(window);
  552.         saved.thisport := window;
  553.         saved.font := window^.txFont;
  554.         saved.size := window^.txSize;
  555.         saved.face := window^.txFace;
  556.         TextFont(font);
  557.         TextSize(size);
  558.         TextFace(face);
  559.     end;
  560.  
  561.     procedure ExitWindow (saved: SavedWindowInfo);
  562.     begin
  563.         SetPort(saved.thisport);
  564.         TextFont(saved.font);
  565.         TextSize(saved.size);
  566.         TextFace(saved.face);
  567.         SetPort(saved.oldport);
  568.     end;
  569.  
  570.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  571.         const
  572.             left_indent = 20;
  573.             gap = 2;
  574.         var
  575.             r, er: rect;
  576.             fi: FontInfo;
  577.             sw: integer;
  578.     begin
  579.         GetDItemRect(dlg, item, r);
  580.         GetFontInfo(fi);
  581.         MoveTo(r.left + left_indent, r.top + fi.ascent);
  582.         sw := StringWidth(title);
  583.         er.top := r.top;
  584.         er.bottom := er.top + fi.ascent + fi.descent;
  585.         er.left := r.left + left_indent;
  586.         er.right := er.left + sw;
  587.         EraseRect(er);
  588.         DrawString(title);
  589.         PenPat(gray);
  590.         r.top := r.top + (fi.ascent) div 2;
  591.         MoveTo(er.left - gap, r.top);
  592.         LineTo(r.left, r.top);
  593.         LineTo(r.left, r.bottom);
  594.         LineTo(r.right, r.bottom);
  595.         LineTo(r.right, r.top);
  596.         LineTo(er.right + gap, r.top);
  597.         PenNormal;
  598.     end;
  599.  
  600. end.